perm filename NOIR.F4[MSS,LCS] blob sn#133838 filedate 1974-11-29 generic text, type T, neo UTF8
00010	C**************  NOIR, RJBX, CENTX ***************
00100		SUBROUTINE NOIR(RMINI)
00200	C  BLACKS IN NOTES
00400	      COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(12),B,C,KC,D,N,JY,M,L
00500		COMMON/PLTR/IPLT,RHT,DIS /XRN/IRN(4000)
00700		EQUIVALENCE (PRE,IRN(1))
00900		DATA BL/7.5/,BH/6.7/
01000	C  ADJUST BH AND FL FOR HEIGHT OF NOTE AND 'WIDTH'
01100		IPOS=ROFF(RJB*DIS)
01150		IF(RMINI.LT.1)IPOS=IPOS+1
01200		JPOS=ROFF(CENTR*RHT)
01300		IF(-RMINI.EQ.PRE)GO TO 10
01400		PRE=-RMINI
01950		D=.25*RMINI
02000		B=BH*RMINI*RHT
02010		E=RMINI*DIS
02100		A=BL*E
02200		IC=A
02300		A=A*A
02400	CC	K=B+FL
02410	CXX	IF(E.LT.1.)E=1.
02420	C  TO SHIFT NOTE TO RIGHT A LITTLE
02500	CXX	E=E-B/4.
02550		E=-B/4.
02600		K=B
02700		B=B*B
02800	C  USES EQUATION FOR ELLIPSE
02900		N=1
03500		NX=2
03600	6	DO 1 J=-K,K
03700		Y=J*J
03900		X=SQRT(A-(A*Y)/B)
04000		L=E-X
04100		M=X+E
04200	C  THE TWO SIDES OF THE LINE
04300		IF(N)CALL EXCH(L,M)
04600		IRN(NX)=L
04700		IRN(NX+1)=M
04800	C     C IS VERTICLE POS.
04900		NX=NX+2
05000		E=E+D
05100	C   E IS TO TILT IT.
05200	1	N=-N
05300	10	CALL PLOT(IPOS,JPOS,3)
05400		N=2
05500	C   1ST LOC. OF ARRAY HAS "PRE"
05550		L=IPOS+IC
05600		DO 11 M=-K,K
05700		J=M+JPOS
05800		CALL PLOT(L+IRN(N),J,2)
05900		CALL PLOT(L+IRN(N+1),J,2)
06000	11	N=N+2
06100		END
06200	
06300	
07000	CC	SUBROUTINE NUMB
07200	CCCC	COMMON/SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
07300	CC	DIMENSION ISU(320),R(10,80)
07500	CC	COMMON RJB,JA,CENTR,JB,RJC,RJD,RJE,RJQ(17),JC,JQ(19)
07550	CC	1 /STF/RS(8),RSTJC /POSI/STFF(-3/4),JJB,POS/XRN/RN(4000)
07700	CC	1 /DPY/ST(4000),WDS(250),MEDIT,IGO
07800	CC	EQUIVALENCE (JF,JQ(3)),(ISU(1),ST(3600)),(R,RN(3001))
08000	CC	CALL DPYSET(3,ISU,320)
08100	CC	CALL DPYBRT(6)
08200	CC	JF=1
08300	CC	RA=-100
08600	CCCC	RJD=CENTR+100.*RSTJC
08700	CC	RJD=18
08800	C  RJE=0=1  STANDARD SIZE IS USED.
08820	CCCC	POS=STFF(JC)+100.*RSTJC
08900	CC	DO 1 K=1,80
09000	CC	IF(R(1,K).NE.1.OR.R(2,K).EQ.RA)GO TO 1
09100	CCCC	IF(R(3,K).NE.RB)GO TO 2
09400	CC	RJB=RHORZ(R(2,K))
09600	CC	CALL PNUM
09700	C  GOES TO DRAW A NUMBER OVER A NOTE
09800	CC	JF=JF+1
09900	CC	IF(JF.EQ.10)JF=0
10000	CC1	IF(R(1,K).EQ.0)GO TO 2
10100	CC2	CALL DPYOUT(3)
10200	CC	CALL SETPOG(1)
10400	CC	END
10450	
10500		SUBROUTINE RJBX(R)
10600	       COMMON RJB,RJQ(43)/STF/RSTFAC(8),RSTJC
10700		RJB=RJB+R*RSTJC
10800		END
10900	
11000		SUBROUTINE CENTX
11100	       COMMON A,B,CENTR,D,E,RJD,R(38) /STF/RSTFAC(8),RSTJC
11200		1 /POSI/STFF(8),JJB,POS
11300		CENTR=POS-18.*RSTJC+AMOD(RJD,100.0)*RSTJC*7.
11400		END